Como encontrar as cartas de Gwent mais similares entre si?

boardgames
topic models
stm

Já olhamos os decks de Gwent para identificar e explorar as regras de associação entre as cartas, o que alavanca as estratégias de utilização das mesmas conhecidas pela comunidade. Neste post vamos tomar outra abordagem e buscar os pares de cartas cujas características são mais similares entre si e que, portanto, poderia fornecer algum outro tipo de estratégia ainda não explorada e/ou facilitar a nossa vida quanto à escolha das cartas que colocaremos em um deck

true
01-31-2022

Motivação

Há algum tempo atrás construí um scrapper para raspar a biblioteca de decks de Gwent, de forma à usar esses dados para me ajudar à tomar melhores decisões na hora de montar meus próprios decks. Uma das primeiras análises que fiz com aqueles dados foi tentar entender os padrões de co-ocorrência das cartas de Gwent entre os decks contribuídos pela comunidade, utilizando para isso uma análise orientada à regras de associação. Este primeiro exercício acabou sendo bastante positivo, pois consegui extrair alguns insights bastante relevantes, que acabaram melhorando a minha estratégia e experiência de jogo.

Um ponto importante daquela primeira análise é que ela olhou para os padrões de co-ocorrência de cartas conhecidos e explorados pela comunidade, deixando de fora àquelas combinações de cartas que teriam o potencial de funcionar juntas, mas que nunca foram testadas. Estas combinações normalmente implementam mecânicas específicas de jogo, que podem ser identificadas através da descrição dos efeitos associados à cada carta. Assim, se pudéssemos agrupar as cartas de acordo com os padrões de texto existente em suas descrições, então poderíamos identificar as cartas que implementam mecânicas similares e, portanto, poderiam ser usadas juntas.

Uma forma de implementar este tipo de agrupamento é através da modelagem de tópicos, uma técnica de aprendizado não-supervisionado que faz uso de modelos estatísticos para identificar temas abstratos de acordo com as palavras compõem os textos em uma coleção dos mesmos. Existem alguns modelos que podem ser implementados para esta finalidade, sendo o mais conhecido deles a LDA - Latent Dirichlet Allocation; todavia, vou utilizar este post para estudar, explorar e demonstrar as funcionalidades de um outro modelo de tópicos: o STM, Structural Topic Model (Roberts, Stewart, and Tingley (2019)). Meu objetivo com isso será utilizar este modelo para criar uma representação do quão similares as cartas são de acordo com seus padrões de texto e utilizar esta representação para encontrar as cartas mais similares àquela que eu resolver buscar.

Antes de chegar aos objetivos finais desta análise vamos cobrir alguns pontos importantes. Iniciaremos falando um pouco sobre a aquisição dos dados e, então, passaremos para uma breve análise exploratória. Começaremos a modelagem de tópicos falando um pouquinho mais da intuição por trás do STM e, então, vamos implementar tanto uma busca pela quantidade de tópicos que devemos utilizar antes de ajustar o modelo em si. A partir daí conduziremos algumas análises relacionadas ao pós-processamento e entedimento dos tópicos, bem como a validação do modelo. Fecharemos então o post mostrando a aplicação do modelo para atingir os objetivos principais que definimos.

Carregando os Dados

Os dados que vamos utilizar neste post podem ser obtidos utilizando o scrapper apresentado neste post. O resultado daquele processamento retorna um tibble com a composição de cartas em cada um dos decks rasparados, bem como os metadados associados à cada uma das cartas. Assim, podemos reduzir àquela base à uma que fale apenas das cartas se usarmos um distict focando apenas no nome das cartas e em seus metadados. Você pode encontrar esta etapa do pós-processamento no código que acompanha este post.

Assumindo que já temos a base de dados com os metadados de cada carta, vamos carregar alguns pacotes que usaremos neste post e, na sequência, carregar a base de dados. Precisaremos fazer dois pequenos ajustes, para resolver duas inconsistências que existem neles:

# carregando os pacotes
library(tidyverse) # core
library(tidytext) # para manipular texto
library(patchwork) # para compor figuras
library(stringi) # para trabalhar com texto
library(ggrepel) # para ajudar a plotar
library(reactable) # para tabelas interativas
library(reactablefmtr) # para ajudar com o reactable

# carregando os dados
cartas <- read_rds(file = 'data/cartas.rds')
# cartas <- read_rds(file = '_posts/2022-01-31-card-embeddings-parte-1/data/cartas.rds')

# ajustando a tabela por conta de duas cartas má registradas
cartas <- cartas %>% 
  # removendo a carta Solução Engenhosa, que aparece duas vezes por conta de diferencas
  # em seu nome em ingles
  filter(!(localizedName == 'Solução engenhosa' & name != 'Blueprint')) %>% 
  # ajustando o nome da carta Vidente, que aparece duas vezes pois existe uma na facção
  # neutra e outra na Scoia'tael, mas sao cartas diferentes
  mutate(
    localizedName = case_when(localizedName == 'Vidente' ~ paste0(localizedName, ' (', slug, ')'),
                              TRUE ~ localizedName)
  ) %>% 
  # colocando as cartas em ordem alfabetica
  arrange(localizedName)
cartas

# A tibble: 1,103 × 19
   localizedName name  short slug  rarity cardGroup type  categoryName
   <chr>         <chr> <chr> <chr> <chr>  <chr>     <chr> <chr>       
 1 A Fera        The … mon   Mons… Épica  gold      Unid… Espectro    
 2 A prática le… Prac… nor   Nort… Rara   bronze    Espe… Feitiço     
 3 A Terra das … Land… neu   Neut… Lendá… gold      Arte… Local       
 4 A Trufa Carn… The … neu   Neut… Lendá… gold      Arte… Local       
 5 Abaya         Abaya mon   Mons… Épica  gold      Unid… Necrófago   
 6 Aberrações d… Whor… syn   Synd… Épica  gold      Unid… Humano, Bil…
 7 Abominação S… Sala… syn   Synd… Rara   bronze    Unid… Fera, Mutan…
 8 Acônito       Wolf… neu   Neut… Lendá… gold      Espe… Nenhuma     
 9 Açougueiro d… Sval… ske   Skel… Comum  bronze    Unid… Humano, Cul…
10 Adaga Cerimo… Cere… neu   Neut… Lendá… gold      Estr… Estratégia  
# … with 1,093 more rows, and 11 more variables: ownable <lgl>,
#   decks <int>, craftingCost <int>, power <int>,
#   provisionsCost <int>, armour <int>, keywords <chr>, texto <chr>,
#   fluff <chr>, small <chr>, big <chr>

Se tudo estiver correto, devemos ter 1.103 cartas em nossa base de dados. Além disso, devemos ter muito mais cartas Neutras do que cartas de facção dentro da nossa base, um pouquinho mais de cartas da facção Syndicate do que das demais facções, e um número similar de cartas entre todas as outras cinco facções - conforme apresentado na figura abaixo. Estes padrões de variação na quantidade de cartas parecem estar associados à natureza daquelas duas primeiras: cartas neutras podem ser utilizadas com os decks de qualquer facção, assim como algumas cartas específicas da facção Syndicate.

Show code 
cartas %>% 
  # contando quantidade de cartas existentes por faccao
  count(slug, name = 'n_cartas') %>% 
  # ordenando as colunas
  mutate(slug = fct_reorder(.f = slug, .x = n_cartas)) %>%
  # criando a figura
  ggplot(mapping = aes(x = n_cartas, y = slug, fill = slug)) +
  geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
  geom_text(mapping = aes(label = n_cartas), nudge_x = 10, fontface = 'bold') +
  scale_fill_manual(values = cores_por_faccao) +
  labs(
    title = 'Quantas cartas diferentes existem por facção?',
    x     = 'Quantidade de cartas'
  ) +
  theme(axis.title.y = element_blank())

Com tudo carregado, podemos começar a análise exploratória dos dados das cartas. Nosso principal foco será entender de onde vem as principais diferenças entre as cartas dentro e entre as facções, e como isto está relacionado às estratégias e mecânicas de jogo.

Análise Exploratória de Dados

Vamos começar olhando as nossas análises focando nos textos de descrição associados à cada carta. Para isso, vamos quebrar os textos em tokens utilizando a função unnest_tokens, remover os nomes de algumas das facções que estejam entre os resultados (bem como as cartas que simplesmente não tem nenhum texto associado) e, finalmente, contar quantas vezes cada palavra ocorre em cada carta. Uma vez que tenhamos essa estrutura de dados, vamos usar a função bind_tf_idf para calcular o tf-idf (term frequency-inverse document frequency) associado à cada palavra entre as cartas dentro de cada facção. Esta métrica representa o equilíbrio entre a frequência de ocorrência de uma palavra entre todas as cartas de uma dada facção e a frequência com a qual àquela mesma palavra ocorre entre todas as cartas: quanto mais exclusiva à uma facção for uma palavra, maior será o valor desta métrica. Desta forma, esta métrica nos ajuda à identificar mais facilmente as palavras mais representativas das cartas de cada facção.

Os resultados desta análise preliminar são apresentados na figura abaixo, que confirma a expectativa de que existem diferenças nas palavras associadas aos textos de descrição de cada carta. Ao que podemos observar, estes textos são muito informativos de alguns temas que parecem ser inerentes à cada facção e outros temas que parecem ser comuns entre elas.

Show code 
cartas %>% 
  # quebrando o string em tokens
  unnest_tokens(output = token, input = texto, to_lower = TRUE) %>% 
  # removendo os NAs e algumas palavras que não ajudam a visualização
  filter(!is.na(token), 
         str_detect(string = token, pattern = "scoia'tael|reinos|skellige|norte|dos", negate = TRUE)) %>%
  # contando as categorias por faccao
  count(slug, token, name = 'ocorrencias') %>% 
  # calculando o tf-idf
  bind_tf_idf(term = token, document = slug, n = ocorrencias) %>% 
  # agrupando pela faccao
  group_by(slug) %>% 
  # pegando os 15 tokens com maior tf-idf
  slice_max(order_by = tf_idf, n = 15, with_ties = FALSE) %>% 
  # desagrupando
  ungroup %>% 
  # ordenando as colunas
  mutate(token = reorder_within(x = token, by = tf_idf, within = slug)) %>% 
  # criando a figura
  ggplot(mapping = aes(x = tf_idf, y = token, fill = slug)) +
  facet_wrap(~ slug, scales = 'free') +
  geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
  scale_y_reordered() +
  scale_x_continuous(labels = scales::label_number(accuracy = 0.001)) +
  scale_fill_manual(values = cores_por_faccao) +
  labs(
    title    = 'Quais as palavras mais representativas das cartas de cada facção?',
    subtitle = 'As palavras associadas à cada facção remetem às mecânicas, estratégias e personagens associados à cada uma delas',
    x        = 'TF-IDF'
  ) +
  theme(axis.title.y = element_blank())

Um dos temas comuns que pudemos observar na figura acima é a citação à diversos tipos de personagens comuns em gêneros de RPG. O exemplo mais claro disso é aquele observado na facção Scoia'tael, onde vimos que palavras como elfo, anão e dríade são bastante característicos. Para validar essa observação, calculei o tf-idf focando na informação dos tipos de personagem associados à cada carta, de forma à identificar mais claramente os personagens característicos de cada facção. Em linha com o que esperávamos, os personagens associados à cada facção retratam a natureza de cada uma delas: observamos diversos monstros e nenhum bruxo na facção Monsters, muitas criaturas da floresta, elfos e anões na facção Scoia'tael e diversos personagens associados à guerras e batalhas nas facções Nilfgaard e Northern Realms. Conhecer essas associações são importantes pois algumas mecânicas de jogo dependem do tipo de personagem associado à cada carta (e.g., ‘invoca uma carta da Caçada Selvagem’) e, ainda, existem modos de jogo que favorecem alguns tipos de personagens específicos (e.g., bruxos não são penalizados).

Show code 
cartas %>% 
  # pegando apenas as cartas de unidade
  filter(type == 'Unidade') %>% 
  # quebrando o string em tokens
  unnest_tokens(output = token, input = categoryName, to_lower = FALSE, 
                token = 'regex', pattern = ', ') %>% 
  # contando as categorias por faccao
  count(slug, token, name = 'ocorrencias') %>% 
  # calculando o tf-idf
  bind_tf_idf(term = token, document = slug, n = ocorrencias) %>% 
  # agrupando pela faccao
  group_by(slug) %>% 
  # pegando os 15 tokens com maior tf-idf
  slice_max(order_by = tf_idf, n = 10, with_ties = FALSE) %>% 
  # desagrupando
  ungroup %>% 
  # ordenando as colunas
  mutate(token = reorder_within(x = token, by = tf_idf, within = slug)) %>% 
  # criando a figura
  ggplot(mapping = aes(x = tf_idf, y = token, fill = slug)) +
  facet_wrap(~ slug, scales = 'free') +
  geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
  scale_y_reordered() +
  scale_x_continuous(breaks = seq(from = 0, to = 0.3, by = 0.05)) +
  scale_fill_manual(values = cores_por_faccao) +
  labs(
    title    = 'Quais os tipos de personagem associados às cartas de cada facção?',
    subtitle = 'Os personagens associados à cada facção retratam a natureza de cada uma delas',
    x        = 'TF-IDF'
  ) +
  theme(axis.title.y = element_blank())

Além do texto de descrição das cartas tocar no tema dos tipos de personagem, ela também toca nos tipos de habilidade que cada carta implementa. Na realidade, existem 75 habilidades diferentes que podem estar associadas às cartas, sendo que cada carta pode ter um número qualquer de habilidades - de nenhuma à várias. As habilidades associadas à cada carta são apresentadas na coluna keywords, e são separadas umas das outras através de um ponto-e-vírgula. Para construir o mesmo tipo de intuição sobre as habilidades mais representativas das cartas de cada facção, utilizei novamente o tf-idf. O resultado dessa análise é apresentada através da figura abaixo, onde podemos ver que:

Show code 
cartas %>% 
  # quebrando o string em tokens
  unnest_tokens(output = token, input = keywords, to_lower = FALSE, 
                token = 'regex', pattern = ';') %>% 
  # removendo os NAs
  filter(!is.na(token)) %>%
  # contando as categorias por faccao
  count(slug, token, name = 'ocorrencias') %>% 
  # calculando o tf-idf
  bind_tf_idf(term = token, document = slug, n = ocorrencias) %>% 
  # agrupando pela faccao
  group_by(slug) %>% 
  # pegando os 10 tokens com maior tf-idf
  slice_max(order_by = tf_idf, n = 10, with_ties = FALSE) %>% 
  # desagrupando
  ungroup %>% 
  # ordenando as colunas
  mutate(token = reorder_within(x = token, by = tf_idf, within = slug)) %>% 
  # criando a figura
  ggplot(mapping = aes(x = tf_idf, y = token, fill = slug)) +
  facet_wrap(~ slug, scales = 'free') +
  geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
  scale_y_reordered() +
  scale_fill_manual(values = cores_por_faccao) +
  labs(
    title    = 'Quais as habilidades mais representativas das cartas de cada facção?',
    subtitle = 'Algumas habilidades parecem ser específicas de certas facções, outras são compartilhadas entre poucas',
    x        = 'TF-IDF'
  ) +
  theme(axis.title.y = element_blank())

Se a informação dos tipos de habilidades que uma carta têm está relacionada à descrição da carta, então não bastaria utilizarmos àquela primeira informação para achar as cartas mais similares entre si? Embora essa lógica não esteja errada, ela perde de vista um segundo aspecto importante que podemos encontrar nos textos de descrição de cada carta: a forma como as suas habilidades são implementadas. Vamos tomar como exemplo a habilidade sangramento (i.e., bleeding), que está presente entre as cartas de todas as facções: a carta que possui esta habilidade pode adicionar um status à uma carta inimiga, fazendo com que ela perca um ponto de poder por turno de jogo até um limite n de turnos (que depende da carta). Apesar da ideia por trás desta habilidade ser simples, podemos ver através da figura abaixo que as cartas à implementam de forma bem diferente entre e dentro das facções: e.g. pagando algum tipo de custo, assim que são postas no tabuleiro, quando estão com seu poder aumentado ou quando tem o seu poder aumentado e etc. Assim, é interessante então que agrupemos as cartas não só pelas habilidades que elas compartilham, mas também pela forma como as implementam.

Show code 
cartas %>% 
  # filtrando cartas com uma habilidade especifica
  filter(str_detect(string = keywords, pattern = 'bleeding')) %>% 
  # quebrando o string em tokens
  unnest_tokens(output = token, input = texto, to_lower = TRUE) %>% 
  # removendo os NAs e numeros
  filter(
    !is.na(token),
    str_detect(string = token, pattern = '[0-9]', negate = TRUE),
    !token %in% c('a', 'à', 'ao', 'com', 'de', 'e', 'na', 'no', 'o', 'um')
  ) %>%
  # contando as categorias por faccao
  count(slug, token, name = 'ocorrencias') %>% 
  # calculando o tf-idf
  bind_tf_idf(term = token, document = slug, n = ocorrencias) %>% 
  # agrupando pela faccao
  group_by(slug) %>% 
  # pegando os 10 tokens com maior tf-idf
  slice_max(order_by = tf_idf, n = 10, with_ties = FALSE) %>% 
  # desagrupando
  ungroup %>% 
  # ordenando as colunas
  mutate(token = reorder_within(x = token, by = tf_idf, within = slug)) %>% 
  # criando a figura
  ggplot(mapping = aes(x = tf_idf, y = token, fill = slug)) +
  facet_wrap(~ slug, scales = 'free') +
  geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
  scale_y_reordered() +
  scale_fill_manual(values = cores_por_faccao) +
  labs(
    title    = 'Como a habilidade sangramento é implementada entre facções?',
    subtitle = 'Uma mesma habilidade pode ser implementada de diferentes formas entre e dentro das facções',
    x        = 'TF-IDF'
  ) +
  theme(axis.title.y = element_blank())

Acredito que já conseguimos ter um bom entendimento da relação do texto de descrição das cartas com os tipos de mecânica de jogo e as suas implementações. Vamos agora passar para a modelagem de tópicos, onde buscaremos segmentar as cartas de acordo com estes padrões.

Modelagem

Vamos começar dando um pouco mais de contexto sobre a modelagem de tópicos e de que forma o STM se encaixa dentro deste arcabouço. A partir daí vamos avançar para a preparação dos dados para o modelo, a busca pela quantidade de tópicos que devemos utilizar e, finalmente, ajustaremos o modelo selecionado.

Intuição geral sobre o STM

Os modelos de tópicos são uma família de modelos estatísticos usados para identificar os temas abstratos que permeiam uma coleção de textos, baseando-se na ideia de que se um texto fala sobre um determinado tema, então algumas palavras devem ocorrer com mais frequência ali do que em textos que falam sobre outros temas. Por exemplo, esse texto fala sobre o jogo Gwent, então possivelmente existirão muito mais citações à palavra ‘cartas’ aqui do que nos posts que focam em análises sobre os dados da Fórmula 1. Neste contexto, os modelos de tópicos pertencem à classe de algoritmos de aprendizagem não-supersionado, que buscam identificar as estruturas latentes dentro de um conjunto de dados sem que estas sejam apresentadas explicitamente ao algoritmo.

Um dos modelos de tópico mais famosos é a LDA (Latent Dirichlet Allocation), que tem como premissa principal que cada texto pode ser representado por uma distribuição de tópicos (i.e., prevalência de tópicos) e cada tópico é representado por uma distribuição de palavras (i.e., conteúdo dos tópicos). Posto de outra forma (e de maneira simplista), se conhecermos a frequência de ocorrência das palavras dentro do texto, então podemos saber quais os principais temas que ele aborda. Isto é possível pois a LDA é um modelo generativo, que enxerga cada um dos textos analisados como tendo sido amostrados a partir de uma distribuição de probabilidade que descreve uma coleção de tópicos e estes, por sua vez, de uma amostra de palavras vindas de outra distribuição de probabilidade. Ambas as probabilidades são governadas pela distribuição de Dirichlet, sendo que a distribuição dos tópicos entre os documentos \(\theta_{d}\) (i.e., a prevalência dos tópicos entre os documentos) é governada pelo parâmetro \(\alpha\) daquela distribuição, enquanto a distribuição das palavras por tópico \(\phi_{t}\) (i.e., as palavras ou o conteúdo dos tópicos) é determinada pelo parâmetro \(\beta\)1. Você pode encontrar alguns tutoriais e explicações sobre a LDA aqui, aqui, aqui e aqui.

Show code 
knitr::include_graphics(path = 'images/lda_rationale.png')

Apesar do processo de modelagem da LDA parecer ser complexo, a sua implementação em código é bastante simples. Ela consiste em (a) inicializar aleatoriamente a associação das palavras w e dos documentos d aos tópicos e, então, iterar entre os documentos d e as palavras w e atualizar (a) a estimativa da probabilidade de que cada documento d pertença a um tópico t olhando com que frequência palavras naquele documento são associadss ao tópico t e (b) a estimativa da probabilidade de que cada palavra w pertença a um tópico t com base na quantidade de documentos d que contém a palavra w que foram associados ao tópico t. Com isso, ao longo das iterações, acabamos tendo probabilidades bem calculadas que associam cada documento d e cada palavra w a um tópico t (links para exemplos de implementação da LDA a partir do zero em Python e em R). Todavia, essa simplicidade também traz consigo algumas premissas bem frágeis, como: (1) a independência entre os tópicos, (2) o fato de que as palavras associadas à cada tópico não devem diferir entre os documentos, (3) que os tópicos são determinados exclusivamente pelas palavras que os compõem e, (4) que a ordem das palavras no texto não é relevante para a identificação dos tópicos, apenas a frequência de ocorrência das palavras. Apesar do modelo parar de pé mesmo com essas premissas, elas dificilmente são válidas no mundo real e, portanto, existe um gap de possibilidades que podem ser endereçados por outras alternativas.

Uma das alternativas que surgiram para sanar os gaps da LDA foi o Structural Topic Model (Roberts, Stewart, and Tingley (2019)). A primeira novidade implementada por esse modelo é que tanto o \(\theta_{d}\) (i.e., prevalência dos tópicos) quanto o \(\phi_{t}\) (i.e., conteúdo dos tópicos) podem ser moderados através do efeito de covariáveis (i.e., o \(X\) e o \(\tau\) na figura abaixo). Isto é, algumas covariáveis podem fazer com que a prevalência de alguns tópicos seja naturalmente maior em alguns documentos (e.g., uma característica geral desses documentos) e/ou que algumas palavras de um tópico sejam usadas com mais frequência em algumas condições do que em outras. Outra novidade importante, é que o \(\theta_{d}\) é gerado a partir de uma distribuição LogNormal, o que permite que passemos a incorporar uma estrutura de correlação entre os tópicos (i.e., o \(\epsilon\) na figura abaixo). Finalmente, o \(\phi_{t}\) passa a ser gerado através da soma de algumas distribuições exponenciais, que descrevem coisas como a a frequeência de ocorrência média das palavras nos tópicos, a contribuição das covariáveis sobre a ocorrência das palavras e da ocorrência das palavras dentros tópicos (i.e., o \(\mu\) e o \(\tau\) na figura abaixo). Todas estas melhorias contribuem para que o STM tenha um potencial de uso maior do que aquele da LDA, muito embora a sua utilização para resolução de problemas de modelagem de tópicos ainda pareça ser bem limitada.

Show code 
knitr::include_graphics(path = 'images/stm_rationale.png')

A implementação do Structural Topic Model (STM) que vamos usar é àquela disponível no pacote stm do R. Enquanto escrevo este post, não existe uma implementação deste modelo para o Python, embora existam algumas issues e threads aberta no GitHub do STM com pedidos e discussões. Com essa visão geral sobre o STM, vamos prosseguir agora para a preparação dos dados para a modelagem.

Preparação dos dados

A estrutura de dados que o stm espera receber é uma matriz esparsa onde teremos as cartas como as linhas e as palavras associadas àquela carta como colunas. Além disso, o conteúdo de cada ‘célula’ deve ser a quantidade de vezes que àquela palavra apareceu naquela carta. Colocar os dados nessa estrutura não é uma tarefa tão complexa, embora exija cuidado com alguns detalhes. Em primeiro lugar, vamos precisar remover algumas palavras da nossa matriz simplesmente porque elas são muito frequentes e pouco informativas. Nesse sentido, criei o vetor abaixo para armazenar todas as palavras que serão removidas durante a preparação dos dados - note que existem muitas preposições, substantivos e alguns pronomes entre elas, bem como o nome de algumas facções. Outro ponto importante é que existe uma frase-padrão que é sempre observada ao final do texto das cartas de líder de cada facção. Este texto não é nem um pouco informativo sobre as habilidades da carta e, portanto, devemos removê-lo também - note que temos que usar expressões regulares para isso, uma vez que existe alguma diferença na forma como a frase é escrita entre algumas cartas.

# lista de palavras para remover
my_stopwords <- c('a', 'ao', 'aos', 'ate', 'cada', 'com', 'as', 'como', 'da', 'das', 
                  'de', 'dela', 'delas', 'dele', 'desta',  'deste', 'destas', 'destes',
                  'deles', 'do', 'dos', 'disso', 'e', 'es', 'em', 'esta',  'ela', 'ele',
                  'elas', 'eles', 'for', 'foi', 'la', 'lhe', 'mais', 'nas', 'nesta', 
                  'na', 'nas', 'nela', 'nele', 'no', 'nos', 'o', 'os', 'ou', 'para',
                  'por', 'pelo', 'que', 'sao', 'se', 'so', 'sos', 'sem', 'seu', 'seus',
                  'sua', 'suas', 's', 'si', 'todas', 'todos', 'tem', 'um', 'uma', 'voce',
                  'vez', 'longa', 'distancia', 'corpo', 'duas', 'dois', 'metade', 'reinos',
                  'norte', "scoia'tael", 'skellige', 'nilfgaard', 'sindicato', 'neutra',
                  'concede', 'tiver', 'seguida', 'seja', 'caso', 'faz', 'usa', 'usar',
                  'usando', 'usada', 'usado', 'tambem', 'houver', 'ha', 'pela', 'mesma',
                  'tiver', 'nao', 'nessa', 'nessas', 'nesse', 'nesses', 'qualquer', 
                  'estiver', 'entre', 'unidade', 'unidades', 'mobilizacao', 'sempre', 
                  'mesmo', 'perto', 'apos', 'quando', 'neste', 'nestes', "scoia'tel",
                  'enquanto')

# regex da frase que precisaremos remover
txt <- paste('Esta habilidade adiciona [0-9]{2} (?:(?:de )?recrutamento[s]?',
             'ao limite )?de recrutamento (ao limite )?do (?:seu )?baralho.')

Tendo criado os vetores de palavras e a frase que precisaremos remover, vamos agora processar os textos de cada carta de forma a acabarmos em uma estrutura de dados tidy, que contenha uma coluna para o nome da carta, uma outra para a palavra e uma terceira para a quantidade de vezes que àquela palavra foi observada naquela carta. Para isso, vamos primeiro remover aquele padrão de texto com expressões regulares do campo de descrição da carta usando o str_remove e, na sequência, vamos quebrar o texto em palavras utilizando a função unnest_tokens. Vamos então remover toda a acentuação das palavras restantes usando o stri_trans_general e, então, remover todas àquelas palavras que listamos anteriormente e todos os números. A partir daí vamos utilizar a função str_replace para substiuir a forma do plural para o singular de algumas palavras e padronizar a escrita de algumas palavras. Finalmente, vamos utilizar a função count para determinar quantas vezes cada palavra ocorreu em cada carta. Com isso, chegamos ao resultado que havíamos planejado.

# contando ocorrencias de cada token por faccao
df_tokens <- cartas %>% 
  # removendo texto comum a todas as cartas de habilidade do lider
  mutate(
    texto = str_remove(string = texto, pattern = txt)
  ) %>% 
  # quebrando o string em tokens
  unnest_tokens(output = token, input = texto) %>% 
  # removendo acentuacao
  mutate(token = stri_trans_general(str = token, id = 'Latin-ASCII')) %>%
  # removendo stopwords e os digitos
  filter(!token %in% my_stopwords,
         str_detect(string = token, pattern = '[0-9]', negate = TRUE)) %>% 
  # substituindo algumas as formas de algumas palavras
  mutate(
    # removendo o plural de algumas palavras em especifico
    token = str_replace(string = token, pattern = '(?<=o|a)s$', replacement = ''),
    token = str_replace(string = token, pattern = '(?<=d|t)es$', replacement = 'e'),
    token = str_replace(string = token, pattern = '(?<=r)es$', replacement = ''),
    # padronizando a escrita de algumas habilidades e condicoes
    token = str_replace(string = token, pattern = 'veneno|envenenamento|envenenad[ao]', replacement = 'envenena'),
    token = str_replace(string = token, pattern = 'bloqueada|bloquei[ao]', replacement = 'bloqueio'),
    token = str_replace(string = token, pattern = 'reforcad[ao]', replacement = 'reforcada'),
    # padronizando a escrita de outras palavras
    token = str_replace(string = token, pattern = 'anoes', replacement = 'anao'),
    token = str_replace(string = token, pattern = 'aleatoria(?:mente)?', replacement = 'aleatorio')
    ) %>% 
  # contando ocorrencia dos lemmas por carta
  count(localizedName, token, name = 'ocorrencias') 
df_tokens

# A tibble: 7,425 × 3
   localizedName              token     ocorrencias
   <chr>                      <chr>           <int>
 1 A Fera                     batalha             1
 2 A Fera                     campo               1
 3 A Fera                     fim                 1
 4 A Fera                     maior               1
 5 A Fera                     poder               1
 6 A Fera                     reforca             1
 7 A Fera                     turno               1
 8 A prática leva à perfeição aleatorio           1
 9 A prática leva à perfeição aliado              1
10 A prática leva à perfeição aumenta             1
# … with 7,415 more rows

Podemos criar a matriz esparsa de input para o stm a partir do output do bloco de código anterior utilizando a função tidytext::cast_sparse. Essa função espera receber como argumentos o nome da variavel que será mapeada para as linhas da matriz esparsa (i.e., row = localizedName - o nome das cartas), à que será mapeada para as colunas (i.e., column = token - cada uma das palavras) e àquela que contém os valores de cada célula da matriz (i.e., value = ocorrencias - a frequência com a qual cada palavra ocorre em cada carta). Com isso chegamos à matriz esparsa que precisamos para ajudar o STM aos dados.

# criando matriz no formato document-feature matrix
df_esparsa <- cast_sparse(data = df_tokens, row = localizedName, column = token, value = ocorrencias)

Antes de fechar essa seção, existe uma coisa que acredito que valha a pena comentar. Eu acabei optando por passar algumas palavras para o singular e padronizar a escrita de outras palavras específicas em um dos blocos de código anteriores. Fiz isso pois os resultados preliminares da modelagem não ficaram muito legais inicialmente, uma vez que reparei que os tópicos às vezes separavam só as formas do singular para o plural e, em outros casos, falhavam em incluir as variantes de algumas palavras (e.g., bloqueada, bloqueio e bloqueia). Eu tentei usar o spacyr para corrigir a inflexão das palavras de forma mais robusta (i.e., lemmatização), mas como o corpus do spacy não tem palavras que remetam ao universo dos jogos de RPG, os resultados acabaram sendo até piores (e bizonhos). Assim, resolvi manter simples, e só corrigir aquilo que de fato parecia estar tendo um maior impacto na modelagem. De toda forma, deixo o código que usei para tentar fazer a lemmatização abaixo só para referência no bloco abaixo (ele não tem nenhum efeito sobre o objeto df_tokens).

Show code 
# carregando mais pacotes
library(spacyr) # para ajudar com lematizacao

# inicializando o spacy
spacy_initialize(model = 'pt_core_news_lg')

# criando uma base de-para para lemmatizar os tokens
de_para_lemma <- distinct(df_tokens, token) %>% 
  # colocando os tokens em um vetor
  pull(token) %>% 
  # parseando os tokens para o spacyr
  spacy_parse(pos = FALSE, tag = FALSE, lemma = TRUE, dependency = FALSE) %>% 
  # passando o resultado para um tibble
  tibble %>% 
  # pegando apenas as colunas que interessam
  select(token, lemma)
  
# lemmatizando os tokens e contando ocorrencias
df_tokens <- df_tokens %>% 
  # juntando o de-para de lemmas aos tokens
  left_join(y = de_para_lemma, by = 'token') %>% 
  # contando ocorrencia dos lemmas por carta
  count(localizedName, lemma, name = 'ocorrencias')

Criando features

Como o STM dá suporte ao uso de covariáveis para modelar a prevalência (i.e., ‘quais são os tópicos?’) e o conteúdo dos tópicos (i.e., ‘quais palavras representam os tópicos?’), vamos criar um tibble com alguns metadados sobre cada carta que podem nos ajudar na modelagem. Mais especificamente, a análise exploratória que fizemos sugere que:
+ Os textos de descrição das cartas representam temas distintos, mas que parecem estar relacionados ao conjunto de habilidades que cada carta possui. Posto de outra forma, existe a expectativa de que a prevalência dos tópicos deve variar em função das habilidades existentes entre as cartas (e.g., vai existir um tópico para habilidades relacionadas ao envenenamento, outro tópico para habilidades que causam dano direto e etc.); e,
+ A forma pela qual uma mesma habilidade é implementada varia entre as facções, e pode ser mapeada através de diferenças no texto de descrição das cartas que possuem a mesma habilidade. Isto é, espera-se que o conteúdo de cada tópico varie em função da facção à qual as cartas pertençam (e.g., se existe um tópico relacionado à habilidade de envenamento, as palavras que caracterizam este tópico vão variar facção à facção).

Dada estas duas hipóteses, vamos focar então em criar um tibble que nos permita endereçá-las de forma mais simples e objetiva possivel. Neste contexto, representar a relação entre o conteúdo do tópico e as facções é relativamente fácil: basta termos uma coluna que indique à qual facção pertence cada carta. Por outro lado, representar a relação entre a prevalência dos tópicos e as habilidades das cartas é uma tarefa bem mais complexa, uma vez que existem 1.103 habilidades distintas. Assim, codificar a presença ou ausência de cada habilidade para cada uma das cartas faria com que o número de covariáveis ficasse grande demais (fora ainda que algumas habilidades são observadas em 2 ou 3 cartas e, portanto, teríamos problemas de ortogonalidade). Uma alternativa que encontrei para tentar resolver este problema foi o de separar as habilidades em 3 grupos distintos: as habilidades que causam ou dão algum tipo de status à uma carta, as habilidades que têm algum tipo de área de efeito (e.g., ‘causam dano à todas as unidades inimigas’) e todas as habilidades que não se encaixarem nestes dois últimos grupos. Embora esse agrupamento esteja longe de ser a melhor solução, acredito que ele possa servir pelo menos para nos dar uma noção mínima da relevância de usar explicitamente a informação das habilidades para modelar a prevalência vs deixar com que o modelo de tópicos descubra esse agrupamento latente sozinho. O bloco de código abaixo cria todas estas covariáveis e as organiza no tibble df_covariáveis, que será usado dentro da função stm mais tarde.

# listando todas as habilidades associadas a um status
hab_status <- c('bleeding', 'blood_moon', 'bounty', 'defender', 'doomed', 'immune', 
                'lock', 'poison', 'resilient', 'rupture', 'shield', 'spying', 'vitality',
                'veil')

# listando todas as habilidade que causam algum tipo de efeito de area
hab_aoe <- c('blood_moon', 'cataclysm', 'dragons_dream', 'fog', 'frost', 'rain', 'storm')

# criando tabela com as covariaveis de cada carta
df_covariaveis <- cartas %>% 
  # codificando os dois grupos bem marcados de habilidades e criando um nivel para tudo o que
  # nao se encaixa naqueles dois
  mutate(
    # habilidades associadas que causam ou dao um status a carta
    habilidade_status = str_detect(string = keywords, 
                                   pattern = paste0(hab_status, collapse = '|')),
    # habilidades com efeito de area
    habilidade_aoe = str_detect(string = keywords, 
                                pattern = paste0(hab_aoe, collapse = '|')),
    # todas as habilidades que não se encaixarem nas duas ultimas
    habilidade_outras = str_detect(string = keywords, negate = TRUE,
                                   pattern = paste0(c(hab_status, hab_aoe), collapse = '|'))
  ) %>% 
  # selecionando apenas as covariaveis que vamos usar
  select(localizedName, slug, contains('habilidade')) %>% 
  # substituindo os valores faltantes nas colunas das habilidades por FALSE
  mutate(across(.cols = contains('habilidade'), .fns = replace_na, FALSE))
df_covariaveis

# A tibble: 1,103 × 5
   localizedName              slug            habilidade_stat… habilidade_aoe
   <chr>                      <chr>           <lgl>            <lgl>         
 1 A Fera                     Monsters        FALSE            FALSE         
 2 A prática leva à perfeição Northern Realms FALSE            FALSE         
 3 A Terra das Mil Fábulas    Neutral         TRUE             FALSE         
 4 A Trufa Carnuda            Neutral         TRUE             FALSE         
 5 Abaya                      Monsters        FALSE            FALSE         
 6 Aberrações do Salafrário   Syndicate       FALSE            FALSE         
 7 Abominação Salamandra      Syndicate       TRUE             FALSE         
 8 Acônito                    Neutral         FALSE            FALSE         
 9 Açougueiro de Svalblod     Skellige        TRUE             FALSE         
10 Adaga Cerimonial           Neutral         TRUE             FALSE         
# … with 1,093 more rows, and 1 more variable:
#   habilidade_outras <lgl>

Determinando a quantidade de tópicos

Como em outras técnicas de aprendizado não-supervisionado voltadas ao agrupamento por similaridade, precisamos determinar a quantidade de tópicos K a ser utilizada pelo STM antes de ajustá-lo. Como não temos noção de antemão do melhor valor de K, faremos uma busca em passos incrementais de 3 tópicos dentro de um intervalo de K = 6 à K = 30 tópicos. Além disso, aproveitaremos para determinar se faz sentido ou não utilizar as covariáveis para modelar o conteúdo dos tópicos, a prevalência dos tópicos ou ambos ajustando quatro STM distintas. Nesse contexto, utilizaremos a identidade da facção como a covariável para modelar a variação no conteúdo dos tópicos (i.e., testar a hipótese de que as palavras que representam um mesmo tópico variam entre facções), e a presença ou ausência de cada um dos três grupos de habilidades na carta para modelar a prevalência dos tópicos (i.e., testar a hipótese de que os tópicos falam sobre estes três grupos de habilidades e/ou variações deles). Como precisaremos ajustar 36 modelos de tópicos aos dados (9 valores de K x 4 tipos de modelo), essa será uma etapa bem demorada e, portanto, vamos alavancar o processo multisessão do furrr para ganhar um pouco mais de velocidade.

# carregando mais pacotes
library(stm) # para a modelagem de topicos
library(furrr) # para paralelizar a busca

# setando a seed
set.seed(33)

# setando o processamento paralelo
plan(multisession)

# buscando melhor valor de K
search_K <- tibble(
  K = seq(from = 6, to = 30, by = 3)
) %>% 
  mutate(
    # rodando o STM padrao
    Nenhuma = future_map(.x = K, 
                         .f = ~ stm(documents = df_esparsa, init.type = 'Spectral', 
                                    seed = 333, K = .x, verbose = FALSE),
                         .options = furrr_options(seed = TRUE)
    ),
    # rodando o STM com covariaveis apenas para o conteudo dos topicos
    Conteudo = future_map(.x = K, 
                          .f = ~ stm(documents = df_esparsa, init.type = 'Spectral', 
                                     seed = 333, K = .x, content = ~ slug, data = df_covariaveis,
                                     verbose = FALSE),
                          .options = furrr_options(seed = TRUE)
    ),
    # rodando o STM com covariaveis apenas para a prevalencia dos topicos
    Prevalencia = future_map(.x = K, 
                             .f = ~ stm(documents = df_esparsa, init.type = 'Spectral', 
                                        seed = 333, K = .x, 
                                        prevalence = ~ habilidade_status + habilidade_aoe + habilidade_outras, 
                                        data = df_covariaveis, verbose = FALSE),
                             .options = furrr_options(seed = TRUE)
    ),
    # rodando o STM com covariaveis para o conteudo o prevalencia dos topicos
    Ambas = future_map(.x = K, 
                       .f = ~ stm(documents = df_esparsa, init.type = 'Spectral', 
                                  seed = 333, K = .x, content = ~ slug,
                                  prevalence = ~ habilidade_status + habilidade_aoe + habilidade_outras, 
                                  data = df_covariaveis, verbose = FALSE),
                       .options = furrr_options(seed = TRUE)
    )
  ) %>% 
  pivot_longer(cols = c(Nenhuma, Conteudo, Prevalencia, Ambas), names_to = 'tipo', values_to = 'modelos')

# setando o processamento sequencial
plan(sequential)

Uma vez que os modelos estejam ajustados, vamos calcular três métricas para nos ajudar a avaliar o ajuste do modelo aos dados para cada combinação de valor de K e tipo de modelo. A primeira métrica que vamos avaliar é a coerência semântica, que é uma medida do quão frequente as palavras que compõem um tópico co-ocorrem entre os documentos: quanto maior o valor desta métrica (i.e., menos negativo), maior a qualidade da segmentação entre os tópicos. A métrica seguinte é a exclusividade, que mede o quanto as palavras associadas a um tópico são exclusivas a ele: quanto maior o valor desta métrica, menor o compartilhamento de palavras entre tópicos e, portanto, maior a qualidade da segmentação entre os tópicos. Um ponto importante aqui é que a métrica de exclusividade foi pensada para modelos sem covariáveis para o conteúdo dos tópicos, então não conseguiremos extrai-la para 2 dos 4 tipos de modelos que ajustamos; não há uma explicação junto a documentação da função ou do pacote sobre isso, mas acredito que isto ocorra pelo fato de que ao passar estas covariáveis estamos fazendo com que o modelo considere o fato de que as palavras podem sim ser compartilhadas entre os tópicos, dependendo do contexto das covariáveis. Finalmente, olharemos a dispersão dos resíduos do STM: quanto mais próximo de 1 são os resíduos, maior a força da evidência de que a quantidade de tópicos está bem ajustada.

A figura abaixo apresenta os resultados da variação daquelas três métricas de acordo com o valor de K e o tipo de modelo implementado. Alguns padrões importantes são:
+ Modelos com a covariável da identidade da facção para o conteúdo atingem maior coerência semântica e menor dispersão dos resíduos do que modelos que não fazem uso dessa covariável para um mesmo valor de K;
+ Apesar da coerência semântica voltar a aumentar quando usamos mais de 27 tópicos, os resíduos do modelo de tópicos aumentam muito; e,
+ A exclusividade das palavras aumenta com o valor de K, mas parece aumentar de forma mais devagar depois dos 18 tópicos.

Show code 
# extraindo as metricas de avaliacao da clusterizacao
search_K %>% 
  # calculando a exclusividade e a coerencia dos topicos
  mutate(
    coerencia     = map(.x = modelos, .f = semanticCoherence, documents = df_esparsa),
    exclusividade = map(.x = modelos, .f = safely(exclusivity)),
    exclusividade = map(.x = exclusividade, .f = 'result'),
    residuos      = map(.x = modelos, .f = checkResiduals, df_esparsa),
    residuos      = map(.x = residuos, 'dispersion')
  ) %>% 
  # dropando a coluna com os modelos
  select(-modelos) %>% 
  # desaninhando as colunas de coerencia e exclusividade
  unnest(cols = c(exclusividade, coerencia, residuos)) %>% 
  # passando a base para o formato longo
  pivot_longer(cols = c(exclusividade, coerencia, residuos), 
               names_to = 'metrica', values_to = 'valor') %>% 
  # dropando valores nulos
  drop_na() %>% 
  # agrupando pelo valor de K e da metrica
  group_by(K, metrica, tipo) %>% 
  # calculando o valor da media da metrica por valor de K
  summarise(
    valor = mean(x = valor, na.rm = TRUE), .groups = 'drop'
  ) %>% 
  # renomeando as metricas
  mutate(
    metrica = case_when(metrica == 'coerencia' ~ 'Coerência Semântica',
                        TRUE ~ str_to_title(string = metrica))
  ) %>% 
  # criando a figura
  ggplot(mapping = aes(x = as.factor(K), y = valor, group = tipo, color = tipo)) +
  facet_wrap(~ metrica, scales = 'free') +
  geom_line(size = 1, show.legend = TRUE) +
  geom_point(fill = 'white', color = 'black', shape = 21, size = 2, show.legend = FALSE) +
  labs(
    title    = 'Quantos tópicos devemos usar?', 
    subtitle = 'A quantidade de tópicos escolhida deve atender ao melhor balanço entre uma alta coerência semântica e exclusividade, mas baixos resíduos',
    x        = 'Quantidade de tópicos (K)',
    y        = 'Valor da métrica',
    color    = 'Covariáveis'
  ) +
  theme(
    legend.position = 'bottom'
  )

De acordo com os padrões observados acima e usando um pouco de parsimônia, parece que o melhor modelo de tópicos a ser utilizado é aquele que faz uso de 18 tópicos e usa apenas a covariável da identidade da facção para modelar o conteúdo dos tópicos (esse modelo é mais simples do que aquele que faz uso de covariáveis para o conteúdo e a prevalência dos tópicos).

Ajustando o modelo

Como já ajustamos o modelo descrito acima quando fizemos a busca pelo valor de K e o tipo de modelo, não precisamos repetir todo o processo. Para poupar esse tempo, basta filtramos a linha correspondente aquele modelo de dentro do tibble que armazena os resultados da busca e extrairmos o objeto do modelo treinado.

# extraindo o melhor modelo
modelo <- search_K %>% 
  # pegando o modelo selecionado
  filter(K == 18, tipo == 'Conteudo') %>% 
  # extraindo o modelo selecionado
  pull(modelos) %>% 
  # tirando o modelo da lista
  pluck(1)

Entendendo os tópicos

Visualizando os topicos encontrados.

Show code 
# extraindo os dados dos betas por topico
df_betas <- modelo$beta %>% 
  # pegando a matriz com o log das probabilidades para o beta
  pluck('logbeta') %>% 
  # parseando as matrizes para um dataframe
  map(.f = data.frame) %>% 
  # passando o log da probabilidade para probabilidade
  map(.f = exp) %>% 
  # colocando o nome nas colunas
  map(.f = ~ `colnames<-`(x = ., value = df_esparsa@Dimnames[[2]])) %>%
  # adicionando o identificador do topico a cada linha
  map(.f = mutate, topic = 1:n()) %>% 
  # renomeando os elementos da lista
  `names<-`(value = c('Monsters', 'Neutral', 'Nilfgaard', 'Northern Realms', 
                      "Scoia'tael", 'Skellige', 'Syndicate')) %>% 
  # juntando todos
  map_dfr(tibble, .id = 'slug') %>%
  # passando a base para o formato longo
  pivot_longer(cols = -c(slug, topic), names_to = 'term', values_to = 'beta')

# criando figura das palavras por topicos
df_betas %>% 
  # agrupando pelo topico e token
  group_by(topic, term) %>% 
  # calculando a media da probabilidade para aquele token naquele topico
  summarise(beta = mean(x = beta, na.rm = TRUE), .groups = 'drop') %>% 
  # agrupando pelo topico
  group_by(topic) %>% 
  # pegando as 10 palavras com maior afinade com cada tópico
  slice_max(order_by = beta, n = 10, with_ties = FALSE) %>% 
  # criando escala numerica para colorir dentro dos topicos
  mutate(escala = beta / max(beta)) %>% 
  # desagrupando os dados
  ungroup %>% 
  # organizando as informacoes para plotar
  mutate(
    topic = ifelse(test = topic < 10, 
                   yes = paste0('Tópico 0', topic), no = paste0('Tópico', topic)),
    term = reorder_within(x = term, by = beta, within = topic)
  ) %>% 
  # criando a figura
  ggplot(mapping = aes(x = beta, y = term, fill = escala)) +
  facet_wrap(~ topic, scales = 'free', ncol = 4) +
  geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
  scale_y_reordered() +
  scale_fill_viridis_c(begin = 0.2, end = 0.9) +
  labs(
    title    = 'Quais as palavras mais prováveis de serem observadas em cada tópico?',
    x        = expression(bold(paste('Probabilidade de ocorrência, ', beta)))
  ) +
  theme(axis.title.y = element_blank())
Show code 
# o codigo abaixo pode ser usado para criar a figura das palavras mais relacionadas com
# cada topico no caso de não utilizarmos covariáveis para modelar o conteúdo dos tópicos,
# uma vez que nesse caso temos apenas uma matriz beta como output do modelo
# tidy(x = modelo, matrix = 'beta') %>% 
#   # agrupando pelo topico
#   group_by(topic) %>% 
#   # pegando as 10 palavras com maior afinade com cada tópico
#   slice_max(order_by = beta, n = 10, with_ties = FALSE) %>% 
#   # criando escala numerica para colorir dentro dos topicos
#   mutate(escala = beta / max(beta)) %>% 
#   # desagrupando os dados
#   ungroup %>% 
#   # organizando as informacoes para plotar
#   mutate(
#     topic = ifelse(test = topic < 10, 
#                    yes = paste0('Tópico 0', topic), no = paste0('Tópico', topic)),
#     term = reorder_within(x = term, by = beta, within = topic)
#   ) %>% 
#   # criando a figura
#   ggplot(mapping = aes(x = beta, y = term, fill = escala)) +
#   facet_wrap(~ topic, scales = 'free', ncol = 4) +
#   geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
#   scale_y_reordered() +
#   scale_fill_viridis_c(begin = 0.2, end = 0.9) +
#   labs(
#     title    = 'Quais as palavras mais prováveis de serem observadas em cada tópico?',
#     x        = expression(bold(paste('Probabilidade de ocorrência, ', beta)))
#   ) +
#   theme(axis.title.y = element_blank())

Visualizando a proporcao de topicos.

Show code 
# # criando dataframe com as palavras mais frequentes por topico na media
# # é necessário descomentar as linhas abaixo se usarmos o modelo sem covariáveis no conteudo
# df_top_palavras <- tidy(x = modelo, matrix = 'beta') %>%
#   # agrupando pelo topico
#   group_by(topic) %>%
#   # pegando as 10 palavras com maior afinade com cada tópico
#   slice_max(order_by = beta, n = 5, with_ties = FALSE) %>%
#   # colocando essas palavras em um vetor
#   summarise(palavras = paste0(term, collapse = ', '))

# é necessário descomentar as linhas abaixo se usarmos o modelo com covariáveis no conteudo
df_top_palavras <- df_betas %>%
  # agrupando pelo topico e token
  group_by(topic, term) %>% 
  # calculando a media da probabilidade para aquele token naquele topico
  summarise(beta = mean(x = beta, na.rm = TRUE), .groups = 'drop') %>% 
  # agrupando pelo topico
  group_by(topic) %>%
  # pegando as 10 palavras com maior afinade com cada tópico
  slice_max(order_by = beta, n = 5, with_ties = FALSE) %>%
  # colocando essas palavras em um vetor
  summarise(palavras = paste0(term, collapse = ', '))

# criando a figura de prevalencia por topico
tidy(x = modelo, matrix = 'gamma') %>% 
  # agrupando pelo topico
  group_by(topic) %>% 
  # extraindo a media da probabilidade para cada topico
  # esse é o valor esperado da prevalencia do tópico
  summarise(
    media = mean(x = gamma), .groups = 'drop'
  ) %>% 
  # juntando as 5 palavras mais frequentes por topico
  left_join(y = df_top_palavras, by = 'topic') %>% 
  # reordenando as colunas
  mutate(
    topic = ifelse(test = topic < 10, yes = paste0('0', topic), no = topic),
    topic = paste('Tópico', topic),
    topic = fct_reorder(.f = topic, .x = media)
  ) %>% 
  # criando a figura
  ggplot(mapping = aes(x = media, y = topic, fill = media)) +
  geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
  geom_text(mapping = aes(label = round(x = media, digits = 3), color = media <= 0.04), 
            nudge_x = -0.01, fontface = 'bold', show.legend = FALSE) +
  geom_text(mapping = aes(label = palavras), nudge_x = 0.005, hjust = 0) +
  scale_x_continuous(breaks = seq(from = 0, to = 0.25, by = 0.05),
                     limits = c(0, 0.27)) +
  scale_fill_viridis_c(begin = 0.2, end = 0.9) +
  scale_color_manual(values = c('black', 'white')) +
  labs(
    title    = 'Quais os tópicos mais prevalentes entre as cartas?',
    subtitle = '',
    x        = expression(bold(paste('Probabilidade de ocorrência, ', gamma)))
  ) +
  theme(axis.title.y = element_blank())

Visualiza correlação entre topicos.

Show code 
# carregando pacotes
library(corrr) # para o plot abaixo

# criando uma plot de correlacao entre os topicos
topicCorr(model = modelo) %>% 
  # pegando a matriz de correlacao
  pluck('cor') %>% 
  # colocando o nome das dimensoes
  `rownames<-`(value = paste0('Tópico ', 1:18)) %>% 
  `colnames<-`(value = paste0('Tópico ', 1:18)) %>% 
  # passando para uma matriz do corrr
  as_cordf() %>% 
  # passando a matriz de correlacao para o formato longo
  stretch(na.rm = TRUE, remove.dups = TRUE) %>% 
  # adicionando contagem de ocorrencias de x e y para ordenar as linhas
  # e colunas da figura
  add_count(x, name = 'n_x') %>% 
  add_count(y, name = 'n_y') %>% 
  mutate(
    y = fct_reorder(.f = y, .x = n_y, .desc = TRUE),
    x = fct_reorder(.f = x, .x = n_x, .desc = TRUE)
  ) %>% 
  # criando a figura
  ggplot(mapping = aes(x = x, y = y, fill = r)) +
  geom_tile(color = 'black') +
  geom_text(mapping = aes(label = round(x = r, digits = 2), color = abs(x = r) > 0.3), 
            fontface = 'bold', show.legend = FALSE) +
  scale_fill_gradient2(low = 'firebrick', mid = 'white', high = 'dodgerblue2', midpoint = 0) +
  scale_color_manual(values = c('NA', 'black')) +
  labs(
    title    = 'Qual a relação entre os tópicos identificados?',
    subtitle = 'São poucos os tópicos que compartilham algum tipo de relação'
  ) +
  theme(
    axis.title  = element_blank(),
    panel.grid  = element_blank(),
    axis.text.x = element_text(angle = 30, hjust = 1)
  )

Estimando a relacao entre topicos e metadados.

# estimando a contribuicao das features para explicar os topicos
explica_topicos <- estimateEffect(1:18 ~ 0 + slug, stmobj = modelo, 
                                  metadata = df_covariaveis, uncertainty = 'Global')
# pegando um output de exemplo
pluck(summary(explica_topicos), 'tables', 15)

                      Estimate Std. Error  t value     Pr(>|t|)
slugMonsters        0.07549279 0.01586946 4.757110 2.225952e-06
slugNeutral         0.10336330 0.01235826 8.363902 1.825868e-16
slugNilfgaard       0.12798473 0.01823497 7.018643 3.919239e-12
slugNorthern Realms 0.08300819 0.01634805 5.077561 4.489758e-07
slugScoia'tael      0.08103286 0.01458370 5.556398 3.456249e-08
slugSkellige        0.07733061 0.01510946 5.118027 3.643883e-07
slugSyndicate       0.06722381 0.01457347 4.612754 4.441963e-06
Show code 
# pegando as estimativas do modelo e ajustando elas à uma PCA usando o vegan
df_beta_escores <- tidy(x = explica_topicos) %>% 
  # ajustando os dados para plotar
  mutate(
    # ajustando o nome das faccoes
    term  = str_remove(string = term, pattern = 'slug'),
    # ajustando o nome dos topicos
    topic = ifelse(
      test = topic < 10, yes = paste0('T0', topic), no = paste0('T', topic)
    )
  ) %>% 
  # pegando apenas o topico, o nome da faccao e o beta da regressao
  select(topic, term, estimate) %>% 
  # passando o tibble para o formato largo, com as faccoes nas linhas, os topicos
  # nas colunas e os betas como os valores das celulas
  pivot_wider(id_cols = term, names_from = topic, values_from = estimate) %>% 
  # passando o tibble para um dataframe, de forma a conseguirmos usar rownames
  data.frame %>% 
  # passando o nome da faccao para o rownames
  `rownames<-`(value = .$term) %>% 
  # dropando a coluna com o nome da faccao
  select(-term) %>% 
  # padronizando os betas topico a topico
  scale %>%
  # ajustando a PCA usando o vegan
  vegan::rda() %>% 
  # extraindo os escores da PCA
  vegan::scores() %>% 
  # passando o objeto resultante para um dataframe
  map(.f = data.frame) %>% 
  # colocando o nome da faccao ou topico como uma coluna
  map(.f = rownames_to_column, var = 'nome')

# criando a figura
ggplot() +
  geom_hline(yintercept = 0, color = 'grey70') +
  geom_vline(xintercept = 0, color = 'grey70') +
  geom_point(data = pluck(df_beta_escores, 'sites'), 
             mapping = aes(x = PC1, y = PC2, fill = nome), 
             size = 3, shape = 21) +
  geom_text_repel(data = pluck(df_beta_escores, 'sites'), 
                  mapping = aes(x = PC1, y = PC2, label = nome, color = nome),
                  fontface = 'bold', seed = 33) +
  geom_text(data = pluck(df_beta_escores, 'species'), 
            mapping = aes(x = PC1, y = PC2, label = nome)) +
  scale_fill_manual(values = cores_por_faccao) + 
  scale_color_manual(values = cores_por_faccao) +
  labs(
    title    = 'Quais facções estão mais fortemente associadas com quais tópicos?',
    subtitle = 'Algumas facções parecem estar mais relacionadas à determinados tópicos do que outras'
  ) +
  theme(
    legend.position = 'none'
  )

Utilizando os tópicos

Juntando probabilidades às cartas.

# pegando a matriz gamma - as probabilidade de cada topico por documento
embeddings <- tidy(x = modelo, matrix = 'gamma') %>% 
  # juntando o prefixo topic_ ao numero de cada topico
  mutate(topic = paste0('topic_', topic)) %>% 
  # pivoteando a tabela para o formato largo
  pivot_wider(id_cols = document, names_from = topic, values_from = gamma) %>% 
  # agrupando o dataframe por linha
  rowwise() %>% 
  # extraindo o topico mais provavel por linha
  mutate(
    topK = which.max(c_across(contains('topic_'))),
    topK = ifelse(test = topK < 10, yes = paste0('Tópico 0', topK), no = paste0('Tópico ', topK))
  ) %>% 
  # desagrupando o dataframe
  ungroup %>% 
  # colocando o nome das cartas na coluna do nome do documento
  mutate(document = cartas$localizedName) %>% 
  # juntando os metadados das cartas
  left_join(y = cartas, by = c('document' = 'localizedName'))
embeddings

# A tibble: 1,103 × 38
   document    topic_1 topic_2 topic_3 topic_4 topic_5 topic_6 topic_7
   <chr>         <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>
 1 A Fera       0.0316  0.0332  0.0424 0.0106  0.0268  0.0849  0.00470
 2 A prática …  0.0167  0.0287  0.0481 0.0557  0.0341  0.0468  0.00585
 3 A Terra da…  0.0189  0.0473  0.217  0.0431  0.0249  0.0171  0.0122 
 4 A Trufa Ca…  0.0122  0.0621  0.0513 0.0582  0.0525  0.0129  0.0105 
 5 Abaya        0.0104  0.0338  0.0116 0.0229  0.00804 0.00995 0.00962
 6 Aberrações…  0.0211  0.0329  0.0166 0.00459 0.0219  0.0361  0.00431
 7 Abominação…  0.0997  0.0287  0.0440 0.00978 0.0335  0.0575  0.00421
 8 Acônito      0.0346  0.0199  0.0221 0.00995 0.00459 0.312   0.00299
 9 Açougueiro…  0.0267  0.0530  0.0191 0.00652 0.0146  0.0826  0.00914
10 Adaga Ceri…  0.0324  0.0815  0.0233 0.00861 0.0123  0.106   0.0129 
# … with 1,093 more rows, and 30 more variables: topic_8 <dbl>,
#   topic_9 <dbl>, topic_10 <dbl>, topic_11 <dbl>, topic_12 <dbl>,
#   topic_13 <dbl>, topic_14 <dbl>, topic_15 <dbl>, topic_16 <dbl>,
#   topic_17 <dbl>, topic_18 <dbl>, topK <chr>, name <chr>,
#   short <chr>, slug <chr>, rarity <chr>, cardGroup <chr>,
#   type <chr>, categoryName <chr>, ownable <lgl>, decks <int>,
#   craftingCost <int>, power <int>, provisionsCost <int>, …

Ajustando TSNE.

Show code 
# carregando o pacote
library(Rtsne) # para rodar o TSNE
library(plotly) # para visualizar o TSNE

# setando a seed
set.seed(33)

# ajustando o TSNE
tsne_results <- select(embeddings, contains('topic_')) %>% 
  # passando objeto para matrix
  as.matrix() %>% 
  # ajustando tSNE
  Rtsne(check_duplicates = FALSE, perplexity = 20)

# plotando resultados do TSNE
tsne_results %>% 
  # pegando os resultado do TSNE
  pluck('Y') %>% 
  # passando para um dataframe
  data.frame %>% 
  # renomeando as colunas
  `names<-`(value = c('tsne1', 'tsne2')) %>% 
  # passando para um tibble
  tibble %>% 
  # juntando com o nome das cartas
  bind_cols(embeddings) %>% 
  # criando a figura
  plot_ly(x = ~ tsne1, y = ~ tsne2, color = ~ slug, data = ., colors = cores_por_faccao,
          mode = 'markers', type = 'scatter', marker = list(size = 7, opacity = 0.7),
          hoverinfo = 'text', 
          hovertext = ~ paste0(
            '<b>Tópico prevalente:</b> ', topK, '<br>',
            '<b>Carta:</b> ', document, '<br>',
            '<b>Raridade:</b> ', rarity, '<br>',
            '<b>Tipo:</b> ', type, '<br>',
            str_wrap(string = texto, width = 50)
            )
  ) %>% 
  layout(xaxis = list(title = 'Dimensão 1'), yaxis = list(title = 'Dimensão 2'))

Nearest neighbors.

# carregando funcoes
library(widyr) # para trabalhar em formato largo

# colocando os embeddings no formato para a funcao abaixo
df_embedding <- select(embeddings, document, contains('topic_')) %>% 
  # passando a base para o formato longo
  pivot_longer(cols = contains('topic_'), names_to = 'topico', values_to = 'probabilidade')

# criando funcao para calcular o nearest neighbors
nearest_neighbors <- function(df, carta, vizinhos) {
  
  # pegando a faccao da carta selecionada
  faccao_selecionada <- cartas %>% 
    # filtrando a carta selecionada
    filter(localizedName == carta) %>% 
    # pegando a faccao da carta
    pull(slug)
  
  # filtrando as cartas que serao comparadas
  if(faccao_selecionada != 'Neutral') {
  cartas_usaveis <- cartas %>% 
    # filtrando todas as cartas da faccao da carta selecionada
    filter(slug %in% faccao_selecionada) %>% 
    # pegando o nome das cartas
    pull(localizedName)
  # pegando todas as cartas caso a facção da carta alvo seja a neutra
  } else {
    cartas_usaveis <- pull(cartas, localizedName)
  }
  
  # calculando a similaridade de coseno entre todas as cartas e a carta alvo
  df %>%
    # filtrando apenas as cartas que serao comparadas
    filter(document %in% cartas_usaveis) %>% 
    # aplicando a funcao
    widely(
      ~ {
        # cria matriz n x m, onde n eh o numero de cartas que existem na base de dados, e m
        # é o número de tópicos identificados através do STM - o conteúdo de cada célular na
        # matriz é a probabilidade de que àquela carta esteja associada aquele tópico
        y <- .[rep(carta, nrow(.)), ]
        # no codigo abaixo o '.' representa a matriz de probablidades de cada carta possuir
        # cada tópico, e é uma matriz n x m onde o n é cada uma das cartas e o m corresponde
        # a várias colunas que representam cada um dos tópicos. Calcularemos então a similaridade
        # do conseno a carta selecionado e o embedding representado por cada outra carta:
        # - rowSums(. * y): multiplica a matriz do embedding de todos as cartas pela matriz
        # da carta selecionada
        # - sqrt(rowSums(. ^ 2)): retorna um vetor numerico, com um elemento por carta o valor
        # associado à cada carta representa o somatorio dos valores entre todas as dimensoes
        # de seu embedding (i.e., todos os topicos associado àquela carta)
        # sqrt(sum(.[token, ] ^ 2)): retorna um valor numérico, que representa o somatório dos
        # valores entre todas as dimensoes do embedding para a carta selecionada
        # (sqrt(rowSums(. ^ 2)) * sqrt(sum(.[token, ] ^ 2))): multiplica o valor do embedding
        # de cada carta pelo da carta selecionado, padronizando a similaridade calculada
        # pelo 'rowSums(. * y)'
        similaridade_coseno <- rowSums(. * y) / (sqrt(rowSums(. ^ 2)) * sqrt(sum(.[carta, ] ^ 2)))
        # coloca o resultado em uma matriz com o nome de linha vinda do nome das cartas
        #matrix(similaridade_coseno, ncol = 1, dimnames = list(x = names(similaridade_coseno)))
      },
      sort = TRUE
    )(document, topico, probabilidade) %>%
    # organizando as cartas em ordem decrescente de similaridade
    arrange(desc(item2)) %>% 
    # pegando apenas a quantidade desejada de cartas similares
    slice_max(order_by = item2, n = vizinhos) %>% 
    # juntando com metadados das cartas resultantes
    left_join(y = select(cartas, localizedName, slug, small, texto), by = c('item1' = 'localizedName'))
}

Exemplo Scoia’tael.

Show code 
df_embedding %>% 
  # calculando o nearest neighbors
  nearest_neighbors(carta = 'Zoltan Chivay', vizinhos = 5) %>% 
  # selecionando as colunas que vamos plotar
  select(small, item1, item2, texto) %>% 
  # adicionando o prefixo do link para a imagem
  mutate(small = paste0('https://www.playgwent.com/', small)) %>%
  # colocando os exemplos em um reactable
  reactable(
    compact = TRUE, borderless = TRUE, defaultColDef = colDef(align = 'left'), 
    style = list(fontFamily = "Roboto", fontSize = "12px"),
    columns = list(
      small = colDef(name = '', cell = embed_img(height = 80, width = 60), maxWidth = 80),
      item1 = colDef(name = 'Carta', maxWidth = 90),
      item2 = colDef(name = 'Similaridade', maxWidth = 90, format = colFormat(digits = 3)),
      texto = colDef(name = 'Descrição')
    )
  )

Exemplo Northern Realms.

Show code 
df_embedding %>% 
  # calculando o nearest neighbors
  nearest_neighbors(carta = 'Imortais', vizinhos = 5) %>% 
  # selecionando as colunas que vamos plotar
  select(small, item1, item2, texto) %>% 
  # adicionando o prefixo do link para a imagem
  mutate(small = paste0('https://www.playgwent.com/', small)) %>%
  # colocando os exemplos em um reactable
  reactable(
    compact = TRUE, borderless = TRUE, defaultColDef = colDef(align = 'left'), 
    style = list(fontFamily = "Roboto", fontSize = "12px"),
    columns = list(
      small = colDef(name = '', cell = embed_img(height = 80, width = 60), maxWidth = 80),
      item1 = colDef(name = 'Carta', maxWidth = 140),
      item2 = colDef(name = 'Similaridade', maxWidth = 90, format = colFormat(digits = 3)),
      texto = colDef(name = 'Descrição')
    )
  )

Exemplo Nilfgaard.

Show code 
df_embedding %>% 
  # calculando o nearest neighbors
  nearest_neighbors(carta = 'Artorius Viggo', vizinhos = 5) %>% 
  # selecionando as colunas que vamos plotar
  select(small, item1, item2, texto) %>% 
  # adicionando o prefixo do link para a imagem
  mutate(small = paste0('https://www.playgwent.com/', small)) %>%
  # colocando os exemplos em um reactable
  reactable(
    compact = TRUE, borderless = TRUE, defaultColDef = colDef(align = 'left'), 
    style = list(fontFamily = "Roboto", fontSize = "12px"),
    columns = list(
      small = colDef(name = '', cell = embed_img(height = 80, width = 60), maxWidth = 80),
      item1 = colDef(name = 'Carta', maxWidth = 140),
      item2 = colDef(name = 'Similaridade', maxWidth = 90, format = colFormat(digits = 3)),
      texto = colDef(name = 'Descrição')
    )
  )

Exemplo Neutral.

Show code 
df_embedding %>% 
  # calculando o nearest neighbors
  nearest_neighbors(carta = 'Alzur', vizinhos = 5) %>% 
  # selecionando as colunas que vamos plotar
  select(small, item1, slug, item2, texto) %>%
  # adicionando o prefixo do link para a imagem
  mutate(small = paste0('https://www.playgwent.com/', small)) %>% 
  # colocando os exemplos em um reactable
  reactable(
    compact = TRUE, borderless = TRUE, defaultColDef = colDef(align = 'left'),
    style = list(fontFamily = "Roboto", fontSize = "12px"),
    columns = list(
      small = colDef(name = '', cell = embed_img(height = 80, width = 60), maxWidth = 80),
      item1 = colDef(name = 'Carta', maxWidth = 140),
      slug  = colDef(name = 'Facção', maxWidth = 90),
      item2 = colDef(name = 'Similaridade', maxWidth = 90, format = colFormat(digits = 3)),
      texto = colDef(name = 'Descrição')
    )
  )

Conclusões

Possíveis Extensões

Dúvidas, sugestões ou críticas? É só me procurar pelo e-mail ou GitHub!

Roberts, Margaret E., Brandon M. Stewart, and Dustin Tingley. 2019. “stm: An R Package for Structural Topic Models.” Journal of Statistical Software 91 (2): 1–40. https://doi.org/10.18637/jss.v091.i02.

  1. A distribuição de Dirichlet possui dois parâmetros, K e \(\alpha\): o primeiro representa a quantidade de categorias que serão descritas e o segundo é um parâmetro que controla quão concentrado em torno de uma categoria é a distribuição de probabilidade - maiores valores de \(\alpha\) levam à uma distribuição de probabilidade mais uniforme. Assim, o \(\alpha\) e o \(\beta\) descritos no texto representam o mesmo parâmetro, mas parecem receber nomes diferentes apenas para não causar confusão↩︎

References